home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / totsrc11.zip / TOTWIN.PAS < prev    next >
Pascal/Delphi Source File  |  1993-06-08  |  37KB  |  1,303 lines
  1. {               Copyright 1991 TechnoJock Software, Inc.               }
  2. {                          All Rights Reserved                         }
  3. {                         Restricted by License                        }
  4.  
  5. {                             Build # 1.10d                            }
  6.  
  7. Unit totWIN;
  8. {$I TOTFLAGS.INC}
  9.  
  10. {
  11.  Development History:
  12.              Mar 15 91  1.00a   Changed DesqView checks.
  13.              Mar 29 91  1.00b   Added method SetWinRestrict to control
  14.                                 whether screen coords are set to within
  15.                                 window border.
  16.              Apr  4 91  1.00c   Fixed window coordinate problem when a
  17.                                 window is stretched.
  18.              Apr 23 91  1.00d   Enabled SetAllowMove for all window
  19.                                 types.
  20.              Feb 03 92  1.00e   Captured 600 as Key Lastkey
  21.              Feb 24 93  1.10a   Change Winkey to check vRemove
  22.              Mar 05 93  1.10b   Changed memory check in Window Move
  23.              May 03 93  1.10c   Set cursor to 1,1 when Window drawn
  24.                                 to avoid a range check error.
  25.                                 Wait for Mouse Release when closing
  26.              Jun 08 93  1.10d   Added checks of vRemove before removing
  27.                                 windows (Thanks Bill).
  28. }
  29.  
  30. {
  31.  Development Notes:
  32.                 600 = Close Window
  33.                 601 = Moved
  34.                 602 = Resized
  35.                 610 = Scroll Up One
  36.                 611 = Scroll Down One
  37.                 612 = Scroll Left one
  38.                 613 = Scroll Right one
  39.                 614 = Vertical Scroll Bar
  40.                 615 = Horizontal Scroll Bar
  41. }
  42.  
  43. INTERFACE
  44.  
  45. uses DOS, CRT, totSYS, totLOOK, totINPUT, totFAST, totMISC;
  46.  
  47. TYPE
  48.  
  49. WinPtr = ^WinOBJ;
  50. pWinOBJ = ^WinOBJ;
  51. WinOBJ = object
  52.    vBorder: tCoords;
  53.    vOuter: tCoords;
  54.    vClose: boolean;            {is close icon active}
  55.    vUnderneathPtr: pointer;    {ptr to saved screen}
  56.    vSavedSize: longint;        {amount of memory saved}
  57.    vTitle: string;             {window title}
  58.    vBorderAttr: byte;          {border attribute}
  59.    vTitleAttr: byte;           {title attribute}
  60.    vBodyAttr: byte;            {main text attribute}
  61.    vIconsAttr: byte;           {close and zoom icon attribute}
  62.    vStyle: byte;               {border style}
  63.    vRemove: boolean;           {remove the window when done}
  64.    vCursX: byte;               {saved cursor location}
  65.    vCursY: byte;               {saved       -"-      }
  66.    vCursTop: byte;             {saved cursor size}
  67.    vCursBot: byte;             {saved     -"-    }
  68.    vOldWin: tByteCoords;       {previous window coords}
  69.    vOldWinConfine: boolean;    {were window coords active}
  70.    vMVisible: boolean;         {was mouse visible}
  71.    vFillWin: boolean;          {clear window core when redrawn}
  72.    vWinRestrict: boolean;      {are windows coords relative to border}
  73.    {methods...}
  74.    constructor Init;
  75.    procedure   SetSize(X1,Y1,X2,Y2,Style:byte);
  76.    procedure   SetTitle(Title:string);
  77.    procedure   SetColors(Border,Body,Title,Icons: byte);
  78.    procedure   SetRemove(On:boolean);
  79.    procedure   SetClose(On:boolean);
  80.    procedure   SetWinRestrict(On:boolean);
  81.    procedure   SetWindow;
  82.    procedure   GetSize(var X1,Y1,X2,Y2,Style:byte);
  83.    function    GetX:byte;
  84.    function    GetY:byte;
  85.    function    GetStyle: byte;
  86.    function    GetBorderAttr: byte;
  87.    function    GetTitleAttr: byte;
  88.    function    GetBodyAttr: byte;
  89.    function    GetIconsAttr: byte;
  90.    function    GetRemoveStatus: boolean;
  91.    procedure   Save;
  92.    procedure   PartSave(X1,Y1,X2,Y2:byte; var Dest);
  93.    procedure   PartRestore(X1,Y1,X2,Y2:byte; var Source);
  94.    procedure   ComputeSavedCoords;
  95.    procedure   DrawCore;
  96.    procedure   GrowDraw;
  97.    procedure   Remove;
  98.    procedure   WinGetKey(var K:word;var X,Y:byte);
  99.    procedure   SetBoundary(X1,Y1,X2,Y2:byte);                  VIRTUAL;
  100.    procedure   WinKey(var K:word;var X,Y:byte);                VIRTUAL;
  101.    procedure   Draw;                                           VIRTUAL;
  102.    destructor  Done;                                           VIRTUAL;
  103. end; {WinOBJ}
  104.  
  105. MoveWinPtr = ^MoveWinOBJ;
  106. pMoveWinOBJ = ^MoveWinOBJ;
  107. MoveWinOBJ = object (WinOBJ)
  108.    vBoundary: tCoords;       {max area in which window can move}
  109.    vMoveKey: word;
  110.    vAllowMove: boolean;
  111.    {methods...}
  112.    constructor Init;
  113.    procedure   SetMoveKey(K:word);
  114.    procedure   SetAllowMove(On:boolean);
  115.    procedure   BuildBackground(var BackScr: ScreenOBJ);
  116.    procedure   RemoveShadow(var OriginalScreen: ScreenOBJ);
  117.    procedure   RefreshUnderneath(BackScr: ScreenOBJ);
  118.    procedure   WMove(UsingMouse:boolean;OldX,OldY:byte);
  119.    procedure   WinKey(var K:word;var X,Y:byte);                VIRTUAL;
  120.    procedure   SetBoundary(X1,Y1,X2,Y2:byte);                  VIRTUAL;
  121.    destructor  Done;                                           VIRTUAL;
  122. end; {MoveWinOBJ}
  123.  
  124. pScrollWinOBJ = ^ScrollWinOBJ;
  125. ScrollWinOBJ = object (MoveWinOBJ)
  126.    vScrollV: boolean;       {show vertical scroll bar}
  127.    vScrollH: boolean;       {show horizontal scroll bar}
  128.    {methods ...}
  129.    constructor Init;
  130.    procedure   SetScrollable(Vert,Horiz:boolean);
  131.    procedure   DrawHorizBar(Current,Max: longint);
  132.    procedure   DrawVertBar(Current,Max: longint);
  133.    procedure   Winkey(var K:word;var X,Y:byte);                VIRTUAL;
  134.    procedure   Draw;                                           VIRTUAL;
  135.    destructor  Done;                                           VIRTUAL;
  136. end; {ScrollWinOBJ}
  137.  
  138. StretchWinPtr = ^StretchWinOBJ;
  139. pStretchWinOBJ = ^StretchWinOBJ;
  140. StretchWinOBJ = object (ScrollWinOBJ)
  141.    vZoomed: boolean;        {is window zoomed at present}
  142.    vPreZoom: tCoords;        {size of window in Unzoomed state}
  143.    vMinWidth: byte;         {min width of SmartWin}
  144.    vMinDepth: byte;         {min depth of SmartWin}
  145.    vStretchKey:word;        {keycode for manual stretch}
  146.    vZoomKey:word;           {keycode for zoom}
  147.    vAllowStretch: boolean;  {is user allowed to stretch}
  148.    vSmartStretch: boolean;  {refresh window during stretch}
  149.    {methods ...}
  150.    constructor Init;
  151.    procedure   SetMinSize(Width,depth:byte);
  152.    procedure   Stretch(UsingMouse:boolean;OldX,OldY:byte);
  153.    procedure   SetAllowStretch(On:boolean);
  154.    procedure   ToggleZoom;
  155.    procedure   Refresh;
  156.    procedure   StretchRefresh;                                 VIRTUAL;
  157.    procedure   Winkey(var K:word;var X,Y:byte);                VIRTUAL;
  158.    procedure   Draw;                                           VIRTUAL;
  159.    destructor  Done;                                           VIRTUAL;
  160. end; {StretchWinOBJ}
  161.  
  162. procedure WinInit;
  163.  
  164. IMPLEMENTATION
  165.  
  166. {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  167. {                                                               }
  168. {     U N I T   P R O C E D U R E S   &   F U N C T I O N S     }
  169. {                                                               }
  170. {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  171.  
  172. procedure Error(Err:byte);
  173. {routine to display error}
  174. const
  175.    Header = 'WinTOT error: ';
  176. var
  177.    Msg : string;
  178. begin
  179.    Case Err of
  180.    1: Msg := 'Not enough memory to create window';
  181.    2: Msg := 'Invalid window dimensions';
  182.    3: Msg := 'Not enough memory to create SmartWin';
  183.    else  Msg := 'Unknown Error';
  184.    end; {case}
  185.    Writeln(Header,Msg);
  186. {Maybe Add non-fatal compiler directive}
  187.    halt;
  188. end; {Error}
  189.  
  190. {||||||||||||||||||||||||||||||||||||}
  191. {                                    }
  192. {    W i n O B J   M E T H O D S     }
  193. {                                    }
  194. {||||||||||||||||||||||||||||||||||||}
  195.  
  196. constructor WinOBJ.Init;
  197. {}
  198. begin
  199.    SetSize(10,5,70,20,1);
  200.    SetTitle('');
  201.    SetRemove(true);
  202.    with LookTOT^ do
  203.        SetColors(WinBorder,WinBody,WinTitle,WinIcons);
  204.    vUnderneathPtr := Nil;
  205.    vMVisible := true;
  206.    vClose := true;
  207.    vFillWin := true;
  208.    vWinRestrict := true;
  209. end; {of const WinOBJ.Init}
  210.  
  211. procedure WinOBJ.SetSize(X1,Y1,X2,Y2,Style:byte);
  212. {}
  213. begin
  214. {$IFDEF CH